Shareware Grab Bag/Shareware Grab Bag.iso/001/pibt32s2.arc/PIBASYN2.PAS

Pascal/Delphi Source File | 1985-11-07 | 29.8 KB | 627 lines

(*----------------------------------------------------------------------*)
(*      Async_Carrier_Detect --- Check for modem carrier detect         *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Carrier_Detect : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Carrier_Detect                                 *)
(*                                                                      *)
(*     Purpose:    Looks for modem carrier detect                       *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Carrier_Detect : BOOLEAN;                       *)
(*                                                                      *)
(*           Flag is set TRUE if carrier detected, else FALSE.          *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Async_Carrier_Detect *)

   Async_Carrier_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 7 );

END   (* Async_Carrier_Detect *);

(*----------------------------------------------------------------------*)
(*      Async_Carrier_Drop --- Check for modem carrier drop/timeout     *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Carrier_Drop : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Carrier_Drop                                   *)
(*                                                                      *)
(*     Purpose:    Looks for modem carrier drop/timeout                 *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Carrier_Drop : BOOLEAN;                         *)
(*                                                                      *)
(*           Flag is set TRUE if carrier dropped, else FALSE.           *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Async_Carrier_Drop *)

   Async_Carrier_Drop := NOT ODD( Port[ UART_MSR + Async_Base ] SHR 7 );

END   (* Async_Carrier_Drop *);

(*----------------------------------------------------------------------*)
(*      Async_Term_Ready --- Set terminal ready status                  *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Term_Ready( Ready_Status : BOOLEAN );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Term_Ready                                     *)
(*                                                                      *)
(*     Purpose:    Sets terminal ready status                           *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Term_Ready( Ready_Status : BOOLEAN );                   *)
(*                                                                      *)
(*           Ready_Status --- Set TRUE to set terminal ready on,        *)
(*                            Set FALSE to set terminal ready off.      *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Mcr_Value: BYTE;

BEGIN (* Async_Term_Ready *)

   Mcr_Value := Port[ UART_MCR + Async_Base ];

   IF ODD( Mcr_Value ) THEN Mcr_Value := Mcr_Value - 1;

   IF Ready_Status THEN Mcr_Value := Mcr_Value + 1;

   Port[ UART_MCR + Async_Base ] := Mcr_Value;

END   (* Async_Term_Ready *);

(*----------------------------------------------------------------------*)
(*          Async_Buffer_Check --- Check if character in buffer         *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Buffer_Check : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Buffer_Check                                   *)
(*                                                                      *)
(*     Purpose:    Check if character in buffer                         *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Buffer_Check : BOOLEAN;                         *)
(*                                                                      *)
(*           Flag returned TRUE if character received in buffer,        *)
(*           Flag returned FALSE if no character received.              *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine only checks if a character has been received      *)
(*       and thus can be read; it does NOT return the character.        *)
(*       Use Async_Receive to read the character.                       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN   (* Async_Buffer_Check *)

   Async_Buffer_Check := ( Async_Buffer_Head <> Async_Buffer_Tail );

END     (* Async_Buffer_Check *);

(*----------------------------------------------------------------------*)
(*          Async_Receive --- Return character from buffer              *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Receive( VAR C : Char ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Receive                                        *)
(*                                                                      *)
(*     Purpose:    Retrieve character (if any) from buffer              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Receive( VAR C: Char ) : BOOLEAN;               *)
(*                                                                      *)
(*           C --- character (if any) retrieved from buffer;            *)
(*                 set to CHR(0) if no character available.             *)
(*                                                                      *)
(*           Flag returned TRUE if character retrieved from buffer,     *)
(*           Flag returned FALSE if no character retrieved.             *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN   (* Async_Receive *)

   IF Async_Buffer_Head = Async_Buffer_Tail THEN
      BEGIN (* No character to retrieve *)

         Async_Receive := FALSE;
         C             := CHR( 0 );

      END   (* No character available   *)

   ELSE
      BEGIN (* Character available *)

                   (* Turn off interrupts *)

         INLINE( $FA );       (* CLI --- Turn off interrupts *)

                   (* Get character from buffer *)

         C := Async_Buffer[ Async_Buffer_Tail ];

                   (* Increment buffer pointer.   IF past *)
                   (* end of buffer, reset to beginning.  *)

         Async_Buffer_Tail := Async_Buffer_Tail + 1;

         IF Async_Buffer_Tail > Async_Buffer_Max THEN
            Async_Buffer_Tail := 0;

                   (* Decrement buffer use count *)

         Async_Buffer_Used  := Async_Buffer_Used - 1;

                   (* Turn on interrupts *)

         INLINE( $FB );       (* STI --- Turn on interrupts *)

                   (* Indicate character successfully retrieved *)

         Async_Receive := TRUE;

      END   (* Character available *);

END   (* Async_Receive *);

(*----------------------------------------------------------------------*)
(*   Async_Receive_With_TimeOut --- Return char. from buffer with delay *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Receive_With_Timeout( Secs : INTEGER; VAR C : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Receive_With_Timeout                           *)
(*                                                                      *)
(*     Purpose:    Retrieve character as integer from buffer,           *)
(*                 or return TimeOut if specified delay period          *)
(*                 expires.                                             *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Receive_With_Timeout( Secs: INTEGER; VAR C: INTEGER );  *)
(*                                                                      *)
(*           Secs ---  Timeout period in seconds                        *)
(*           C     --- ORD(character) (if any) retrieved from buffer;   *)
(*                     set to TimeOut if no character found before      *)
(*                     delay period expires.                            *)
(*                                                                      *)
(*     Calls:  Async_Receive                                            *)
(*             TimeOfDay                                                *)
(*                                                                      *)
(*     WATCH OUT!  THIS ROUTINE RETURNS AN INTEGER, NOT A CHARACTER!!!  *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Ch           : CHAR;
   Time_Limit   : REAL;
   B            : BOOLEAN;

BEGIN (* Async_Receive_With_Timeout *)

   IF Async_Buffer_Head <> Async_Buffer_Tail THEN
      BEGIN
         B := Async_Receive( Ch );
         C := ORD( Ch );
      END
   ELSE
      BEGIN
                                   (* Convert time to milliseconds *)

         Time_Limit := Secs * 1000.0;

         WHILE ( Async_Buffer_Head = Async_Buffer_Tail ) AND
               ( Time_Limit > 0.0 ) DO
            BEGIN
               Delay( 1 );
               Time_Limit := Time_Limit - 1.0;
            END;

         IF ( Async_Buffer_Head <> Async_Buffer_Tail ) AND
            ( Time_Limit > 0.0 ) THEN
            BEGIN
               B := Async_Receive( Ch );
               C := ORD( Ch );
            END
         ELSE
            C := TimeOut;

      END;

END   (* Async_Receive_With_Timeout *);

(*----------------------------------------------------------------------*)
(*            Async_Ring_Detect --- Check for phone ringing             *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Ring_Detect : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Ring_Detect                                    *)
(*                                                                      *)
(*     Purpose:    Looks for phone ringing                              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Ring_Detect : BOOLEAN;                          *)
(*                                                                      *)
(*           Flag is set TRUE if ringing detected, else FALSE.          *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Async_Ring_Detect *)

   Async_Ring_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 6 );

END   (* Async_Ring_Detect *);

(*----------------------------------------------------------------------*)
(*          Async_Send --- Send character over communications port      *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Send( C : Char );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Send                                           *)
(*                                                                      *)
(*     Purpose:    Sends character out over communications port         *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send( C : Char );                                       *)
(*                                                                      *)
(*           C --- Character to send                                    *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   TimeOut : INTEGER;

BEGIN   (* Async_Send *)

                   (* Turn on OUT2, DTR, and RTS *)

   Port[UART_MCR + Async_Base] := $0B;

                   (* Wait for DSR using Busy Wait *)

   IF Async_Do_DSR THEN
      BEGIN
         TimeOut := 32767;
         WHILE ( ( Port[UART_MSR + Async_Base] AND $20 ) = 0 ) AND
                 ( TimeOut > -32767 ) DO
            TimeOut := TimeOut - 1;
      END;

                   (* Wait for CTS using Busy Wait *)

   IF Async_Do_CTS THEN
      BEGIN
         TimeOut := 32767;
         WHILE ( ( Port[UART_MSR + Async_Base] AND $10 ) = 0 ) AND
                 ( TimeOut > -32767 ) DO
            TimeOut := TimeOut - 1;
      END;

                   (* Wait for Transmit Hold Register Empty (THRE) *)

   IF TimeOut > -32767 THEN
      TimeOut := 32767;

   WHILE ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) AND
           ( TimeOut > -32767 ) DO
      TimeOut := TimeOut - 1;

                   (* Send the character when port clear *)

   INLINE($FA);                    (* CLI --- disable interrupts *)

   Port[UART_THR + Async_Base] := ORD( C );

   INLINE($FB);                    (* STI --- enable interrupts *)

END    (* Async_Send *);

(*----------------------------------------------------------------------*)
(*          Async_Send_Break --- Send break (attention) signal          *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Send_Break;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Send_Break                                     *)
(*                                                                      *)
(*     Purpose:    Sends break signal over communications port          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_Break;                                             *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Old_Lcr   : BYTE;
   Break_Lcr : BYTE;

BEGIN (* Async_Send_Break *)

   Old_Lcr   := Port[ UART_LCR + Async_Base ];
   Break_Lcr := Old_Lcr;

   IF Break_Lcr >  127 THEN Break_Lcr := Break_Lcr - 128;
   IF Break_Lcr <=  63 THEN Break_Lcr := Break_Lcr +  64;

   Port[ UART_LCR + Async_Base ] := Break_Lcr;

   Delay( 400 );

   Port[ UART_LCR + Async_Base ] := Old_Lcr;

END   (* Async_Send_Break *);

(*----------------------------------------------------------------------*)
(*     Async_Send_String --- Send string over communications port       *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Send_String( S : AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Send_String                                    *)
(*                                                                      *)
(*     Purpose:    Sends string out over communications port            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_String( S : AnyStr );                              *)
(*                                                                      *)
(*           S --- String to send                                       *)
(*                                                                      *)
(*     Calls:  Async_Send                                               *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I : INTEGER;

BEGIN  (* Async_Send_String *)

  FOR I := 1 TO LENGTH( S ) DO
     Async_Send( S[I] )

END    (* Async_Send_String *);

(*----------------------------------------------------------------------*)
(*     Async_Send_String_With_Delays --- Send string with timed delays  *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Send_String_With_Delays( S          : AnyStr;
                                         Char_Delay : INTEGER;
                                         EOS_Delay  : INTEGER  );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Send_String_With_Delays                        *)
(*                                                                      *)
(*     Purpose:    Sends string out over communications port with       *)
(*                 specified delays for each character and at the       *)
(*                 end of the string.                                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_String_With_Delays( S          : AnyStr ;          *)
(*                                       Char_Delay : INTEGER;          *)
(*                                       EOS_Delay  : INTEGER );        *)
(*                                                                      *)
(*           S          --- String to send                              *)
(*           Char_Delay --- Number of milliseconds to delay after       *)
(*                          sending each character                      *)
(*           EOS_Delay  --- Number of milleseconds to delay after       *)
(*                          sending last character in string            *)
(*                                                                      *)
(*     Calls:  Async_Send                                               *)
(*             Async_Send_String                                        *)
(*             Length                                                   *)
(*             Delay                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        This routine is useful when writing routines to perform       *)
(*        non-protocol uploads.  Many computer systems require delays   *)
(*        between receipt of characters for correct processing.  The    *)
(*        delay for end-of-string usually applies when the string       *)
(*        represents an entire line of a file.                          *)
(*                                                                      *)
(*        If delays are not required, Async_Send_String is faster.      *)
(*        This routine will call Async_Send_String is no character      *)
(*        delay is to be done.                                          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I : INTEGER;

BEGIN  (* Async_Send_String_With_Delays *)

   IF Char_Delay <= 0 THEN
      Async_Send_String( S )
   ELSE
      FOR I := 1 TO LENGTH( S ) DO
         BEGIN
            Async_Send( S[I] );
            Delay( Char_Delay );
         END;

   IF EOS_Delay > 0 THEN Delay( EOS_Delay );

END    (* Async_Send_String_With_Delays *);

(*----------------------------------------------------------------------*)
(*      Async_Percentage_Used --- Report Percentage Buffer Filled       *)
(*----------------------------------------------------------------------*)

FUNCTION Async_Percentage_Used : REAL;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Async_Percent_Used                                   *)
(*                                                                      *)
(*     Purpose:    Reports percentage of com buffer currently filled    *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Percentage := Async_Percentage_Used : Real;                   *)
(*                                                                      *)
(*           Percentage gets how much of buffer is filled;              *)
(*           value goes from 0.0 (empty) to 1.0 (totally full).         *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine is helpful when incorporating handshaking into    *)
(*       a communications program.  For example, assume that the host   *)
(*       computer uses the XON/XOFF (DC1/DC3) protocol.  Then the       *)
(*       PC program should issue an XOFF  to the host when the value    *)
(*       returned by Async_Percentage_Used > .75 or so.  When the       *)
(*       utilization percentage drops below .25 or so, the PC program   *)
(*       should transmit an XON.                                        *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Async_Percentage_Used *)

   Async_Percentage_Used := Async_Buffer_Used / ( Async_Buffer_Max + 1 );

END   (* Async_Percentage_Used *);

(*----------------------------------------------------------------------*)
(*     Async_Purge_Buffer --- Purge communications input buffer         *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Purge_Buffer;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Purge_Buffer                                   *)
(*                                                                      *)
(*     Purpose:    Purges communications input buffer                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Purge_Buffer;                                           *)
(*                                                                      *)
(*     Calls:  Async_Receive                                            *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   C: CHAR;
   L: INTEGER;

BEGIN  (* Async_Purge_Buffer *)

   L     := 10000 DIV Async_Baud_Rate;

   IF L <= 0 THEN
      L := 3;

   REPEAT
      DELAY( L )
   UNTIL ( NOT Async_Receive( C ) );

END    (* Async_Purge_Buffer *);

(*----------------------------------------------------------------------*)
(*          Async_Buffer_Full --- Check if com buffer nearly full       *)
(*----------------------------------------------------------------------*)

PROCEDURE Async_Buffer_Full;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Async_Buffer_Full                                    *)
(*                                                                      *)
(*     Purpose:    Check if buffer nearly full, issue XOFF if so.       *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Buffer_Full;                                            *)
(*                                                                      *)
(*     Calls:  Async_Send                                               *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*         An XOFF if issued if the buffer is nearly full and an XOFF   *)
(*         has not been previously issued.  If an XOFF was previously   *)
(*         issued, and the buffer is reasonably empty,  then an XON     *)
(*         is issued.                                                   *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN   (* Async_Buffer_Full *)

   IF ( Async_Buffer_Used * 4 ) > ( Async_Buffer_Max * 3 ) THEN
      BEGIN  (* Buffer too full -- send XOFF if we already haven't *)
         IF ( NOT Async_XOFF_Sent ) THEN
            BEGIN
               Async_Send( Async_XOFF );
               Async_XOFF_Sent := TRUE;
            END
      END    (* Buffer too full *)
   ELSE IF ( Async_Buffer_Used * 4 ) < Async_Buffer_Max THEN
      BEGIN  (* Buffer reasonably empty -- send XON if needed *)
         IF Async_XOFF_Sent THEN
            BEGIN
               Async_Send( Async_XON );
               Async_XOFF_Sent := FALSE;
            END;
      END;

END     (* Async_Buffer_Full *);